Figures for WealthRedistribution Simulation Analysis

Data description

The simulation dataset has data from 275,400 simulatiofvn runs. Simulations iterate over 2 tax regimes (“Wealth Gains Tax”; “Wealth Tax”), 7 numbers of entrepreneurs ( 1,000; 2,000; 5,000; 10,000; 20,000; 50,000; 100,000), and tax rates \(\{0,\stackrel{+0.001}{\dots},0.05\}\) for “Wealth Tax” and \(\{0,\stackrel{+0.005}{\dots},0.2\}\) for “Wealth Gains Tax” both with 51 values. This amounts to \(2 \times 7 \times 51 = 714\) parameter configurations. For each configuration we ran 100 simulation.

These parameters are fixed for each simulation: \(\mu = 0.02\) and \(\sigma = 0.3\) as parameters of the \(\log\)-normal distribution of the random yearly growth rates. This implies an expected growth rate of \(\exp(\mu) = 1.0202\).

Examples of a trajectories over time (TODO!)

Parameters:

Tax rate for “Wealth Tax”: 1.5%

Tax rate for “Wealth Gains Tax”: 11%

Calibrate tax rate for both regimes close to empirically most fitting outcome measures, see below.

Characteristics of the wealth distribution

Tail exponent by population size. Tail exponents are for the upper tail of the inverse cumulative distribution function (icdf).

Code
# d |> filter(stop_tick == 200) |> 
#  ggplot(aes(taxrate, tailexp_top10_stop_tick)) +
#  geom_point(alpha = 0.2) +
#  geom_smooth() +
#  facet_grid(tax_regime ~ N)

d |> summarize(mean_tailexp_top10_stop_tick = mean(tailexp_top10_stop_tick), 
               .by = c(tax_regime, taxrate, Ns)) |> 
 ggplot(aes(taxrate, mean_tailexp_top10_stop_tick, color = Ns)) + 
 geom_line() +
 facet_wrap(~tax_regime, scales = "free_x")

Tail exponent with scaled wealth gains tax rate (divisor 7.5) and different fit for top 10% and top 1% (more noisy).

Code
d |> filter(N == 10000, stop_tick == 200) |> 
 summarize(mean_tailexp_top10_stop_tick = mean(tailexp_top10_stop_tick), 
           mean_tailexp_top1_stop_tick = mean(tailexp_top1_stop_tick), 
           .by = c(tax_regime, taxrate_wealth_scaled_75, Ns)) |> 
 pivot_longer(c(mean_tailexp_top10_stop_tick,
            mean_tailexp_top1_stop_tick)) |> 
 ggplot(aes(taxrate_wealth_scaled_75, value,
            color = tax_regime, linetype = name)) + 
 geom_line() +
 labs(caption = "wealth scaled scales wealth gains tax rates down by divisor 7.5, top1 and top10 fit the tail exponent on the top 1% or top 10%")

Linear Relationship wealth tax and wealth gains tax (1)

More outcome measures for wealth gains scaled down by 7.5 and also for runs with 200 and 1000 ticks.

This linear scale fits well for low tax rates!

Code
d |> filter(N == 10000) |> 
 summarize(median_growth_rate_all = mean(growth_rate_all),
           median_tailexp_top10_stop_tick = mean(tailexp_top10_stop_tick),
           median_tailexp_top1_stop_tick = mean(tailexp_top1_stop_tick),
           median_gini_stop_tick = mean(gini_stop_tick),
           median_share_top10_stop_tick = mean(share_top10_stop_tick),
           median_share_top1_stop_tick = mean(share_top1_stop_tick),
           .by = c(tax_regime, taxrate_wealth_scaled_75, taxrate, Ns, stop_tick)) |> 
 pivot_longer(c(median_growth_rate_all,
                median_tailexp_top10_stop_tick,
                median_tailexp_top1_stop_tick, 
                median_gini_stop_tick,
                median_share_top10_stop_tick, 
                median_share_top1_stop_tick)) |> 
 ggplot(aes(taxrate_wealth_scaled_75, value, color = factor(stop_tick), linetype = tax_regime)) + 
 geom_line() +
  facet_wrap(~name, nrow=2, scales = "free_y") +
   scale_x_continuous(labels = ~paste0("{.red ",100*.,"%}/{.blue ",100*.*7.5,"%}"),
                     name = "{.red Tax rate wealth}/{.blue Tax rate wealth gains}") +
 labs(caption = "Scaling factor wealth gains tax:\nmultiply wealth tax by 7.5") +
 theme(axis.title.x = element_marquee(), axis.text.x = element_marquee())

Linear Relationship wealth tax and wealth gains tax (1)

More outcome measures for wealth gains shifted by 0.005 and scaled down by 5.5 (also for runs with 200 and 1000 ticks).

This linear scale fits well for higher tax rates!

Code
d |> filter(N == 10000) |> 
 summarize(median_growth_rate_all = mean(growth_rate_all),
           median_tailexp_top10_stop_tick = mean(tailexp_top10_stop_tick),
           median_tailexp_top1_stop_tick = mean(tailexp_top1_stop_tick),
           median_gini_stop_tick = mean(gini_stop_tick),
           median_share_top10_stop_tick = mean(share_top10_stop_tick),
           median_share_top1_stop_tick = mean(share_top1_stop_tick),
           .by = c(tax_regime, taxrate_wealth_scaled_60, taxrate, Ns, stop_tick)) |> 
 pivot_longer(c(median_growth_rate_all,
                median_tailexp_top10_stop_tick,
                median_tailexp_top1_stop_tick, 
                median_gini_stop_tick,
                median_share_top10_stop_tick, 
                median_share_top1_stop_tick)) |> 
 ggplot(aes(taxrate_wealth_scaled_60, value, color = factor(stop_tick), linetype = tax_regime)) + 
 geom_line() +
  facet_wrap(~name, nrow=2, scales = "free_y") +
   scale_x_continuous(labels = ~paste0("{.red ",100*.,"%}/{.blue ",100*(.+0.005)*5.5,"%}"),
                     name = "{.red Tax rate wealth}/{.blue Tax rate wealth gains}") +
 labs(caption = "Shift-scaling wealth gains tax:\nmultiply (wealth tax + 0.5%) by 5.5") +
 theme(axis.title.x = element_marquee(), axis.text.x = element_marquee())

A baseline case

First proposal:

Wealth tax 1.5% (see one run above).

Code
d |> filter(tax_regime == "wealth", taxrate == 0.015) |> 
 summarize(Gini = mean(gini_stop_tick), `Tail exponent` = mean(tailexp_top10_stop_tick),
           `Share Top 10%` = mean(share_top10_stop_tick), 
            `Share Top 1%` = mean(share_top1_stop_tick)) |> 
 mutate(across(everything(),\(x) round(x, digits = 3))) |> 
 knitr::kable()
Gini Tail exponent Share Top 10% Share Top 1%
0.694 1.259 0.621 0.325

Wealth gains tax 11% (see one run above).

Code
d |> filter(tax_regime == "wealth gains", taxrate == 0.11) |> 
 summarize(Gini = mean(gini_stop_tick), `Tail exponent` = mean(tailexp_top10_stop_tick),
           `Share Top 10%` = mean(share_top10_stop_tick), 
            `Share Top 1%` = mean(share_top1_stop_tick)) |> 
 mutate(across(everything(),\(x) round(x, digits = 3))) |> 
 knitr::kable()
Gini Tail exponent Share Top 10% Share Top 1%
0.69 1.266 0.616 0.319

Both of these tax rates lead to very similar outcomes. Interestingly, these tax rates also match the point where the loss regime of multiplicative growth regime vanishes (for higher tax rates). Probably this is also the point where the power law tail and the travelling wave form really stabilizes. For tax rates much lower it shows still some log-normal like behavior with unstable (growing variance) and fitted power law exponents below 1.

So, for these tax rates both of out shift-scale relations fit:

Scale fit for low tax rates:
wealth tax 1.5% \(\to\) 1.5% times 7.5 = 11.25% wealth gains tax

Shift-scale fit for high tax rates:
wealth tax 1.5% \(\to\) (1.5% + 0.5%) times 5.5 = 11% wealth gains tax

Gatsby Curve

Code
d |> filter(tax_regime == "wealth", taxrate > 0) |> 
 ggplot(aes(gini_stop_tick, stillintop10_past_tick_3, color = taxrate)) +
 geom_point(alpha = 0.1) + 
 geom_smooth(method = "lm") +
 labs(caption = "wealth tax regime, time lag 10")
`geom_smooth()` using formula = 'y ~ x'
Warning: The following aesthetics were dropped during statistical transformation:
colour.
ℹ This can happen when ggplot fails to infer the correct grouping structure in
  the data.
ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
  variable into a factor?

Code
d |> filter(tax_regime == "wealth gains", taxrate > 0) |> 
 ggplot(aes(gini_stop_tick, stillintop10_past_tick_3, color = taxrate)) +
 geom_point(alpha = 0.1) + 
 geom_smooth(method = "lm") +
 labs(caption = "wealth gains tax regime, time lag 10")
`geom_smooth()` using formula = 'y ~ x'
Warning: The following aesthetics were dropped during statistical transformation:
colour.
ℹ This can happen when ggplot fails to infer the correct grouping structure in
  the data.
ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
  variable into a factor?

Code
d |> filter(taxrate > 0) |> 
 ggplot(aes(gini_stop_tick, stillintop10_past_tick_3, color = tax_regime)) +
 geom_smooth(method = "lm") +
 labs(caption = "time lag 10")
`geom_smooth()` using formula = 'y ~ x'

Code
d |> filter(taxrate > 0) |>
 pivot_longer(c(stillintop10_past_tick_3, 
              stillintop10_past_tick_2, 
              stillintop10_past_tick_1)) |> 
 ggplot(aes(gini_stop_tick, value, 
            color = tax_regime, linetype = name)) +
 geom_smooth(method = "lm") +
 labs(caption = "time lags: past_tick_1 = 50, past_tick_2 = 25, past_tick_3 = 10,")
`geom_smooth()` using formula = 'y ~ x'

Code
d |> filter(taxrate > 0) |>
 pivot_longer(c(stillintop1_past_tick_3, 
              stillintop1_past_tick_2, 
              stillintop1_past_tick_1)) |> 
 ggplot(aes(gini_stop_tick, value, 
            color = tax_regime, linetype = name)) +
 geom_smooth(method = "lm") +
 labs(caption = "time lags: past_tick_1 = 50, past_tick_2 = 25, past_tick_3 = 10,")
`geom_smooth()` using formula = 'y ~ x'